home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 November: Tool Chest / Dev.CD Nov 98 TC.toast / Sample Code / Overview / OOPTESample / UApplication.inc1.p < prev    next >
Encoding:
Text File  |  1994-11-18  |  13.7 KB  |  541 lines  |  [TEXT/MPS ]
  1. {---------------------------------------------------------------------
  2. #
  3. #    Apple Macintosh Developer Technical Support
  4. #
  5. #    MultiFinder-Aware Simple TextEdit Sample Application
  6. #
  7. #    OOPTESample
  8. #
  9. #    UApplication.inc1.p        -    Pascal Source
  10. #
  11. #    Copyright © 1988, 1989 Apple Computer, Inc.
  12. #    All rights reserved.
  13. #
  14. #    Versions:        
  15. #                    1.00                    04/89
  16. #                    1.10                    02/90
  17. #                    1.11                    10/92
  18. #
  19. #    Components:     
  20. #                    BuildOOPTESample            February 1, 1990
  21. #                    MTESample.p                    February 1, 1990
  22. #                    OOPTESample.make            February 1, 1990
  23. #                    TECommon.h                    February 1, 1990
  24. #                    TESampleGlue.a                February 1, 1990
  25. #                    TESample.r                    February 1, 1990
  26. #                    TMLRules.make                February 1, 1990
  27. #                    UApplication.p                February 1, 1990
  28. #                    UApplication.inc1.p            February 1, 1990
  29. #                    UDocument.p                    February 1, 1990
  30. #                    UDocument.inc1.p            February 1, 1990
  31. #                    UTEDocument.p                February 1, 1990
  32. #                    UTEDocument.inc1.p            February 1, 1990
  33. #                    UTESample.p                    February 1, 1990
  34. #                    UTESample.inc1.p            February 1, 1990
  35. #
  36. ---------------------------------------------------------------------}
  37.  
  38. CONST
  39.     kOSEvent                = app4Evt;    { Event used by MultiFinder }
  40.     kSuspendResumeMessage    = $01;        { high byte of suspend/resume event message }
  41.     kClipConvertMask        = $02;        { bit of message field clip conversion }
  42.     kResumeMask                = $01;        { bit of message field for resume vs. suspend }
  43.     kMouseMovedMessage        = $FA;        { high byte of mouse-moved event message }
  44.     
  45.     kErrStrings                = 128;
  46.     rUserAlert                = 129;
  47.     
  48.     eWrongMachine            = 1;
  49.     eSmallSize                = 2;
  50.  
  51.  
  52. (********************************************************************************************)
  53. (*        U t i l i t y   r o u t i n e s                                                        *)
  54. (********************************************************************************************)
  55.  
  56. {This routine is part of the MPW runtime library. This external
  57.  reference to it is done so that we can unload its segment, %A5Init.}
  58.  
  59. PROCEDURE _DataInit;
  60.     EXTERNAL;
  61.  
  62. {$S Main}
  63. {-----------------------------------+
  64. |    AlertUser                        |
  65. +-----------------------------------}
  66. { Display alert, using specified error STR# resource and error code as index }
  67. PROCEDURE AlertUser(errResID:integer; errCode:integer);
  68. VAR
  69.     message: Str255;
  70.     dummy: integer;
  71. BEGIN
  72.     SetCursor(qd.arrow);
  73.     GetIndString(message, errResID, errCode);
  74.     ParamText(message, '', '', '');
  75.     dummy := Alert(rUserAlert, NIL);
  76. END;
  77.  
  78. {$S Main}
  79. {-----------------------------------+
  80. |    BigBadError                        |
  81. +-----------------------------------}
  82. { call AlertUser to display error message, then quit... }
  83. PROCEDURE BigBadError(errResID:integer; errCode: integer);
  84. BEGIN
  85.     AlertUser(errResID,errCode);
  86.     ExitToShell;
  87. END;
  88.  
  89. {$S Initialize}
  90. PROCEDURE InitSeg;
  91. BEGIN
  92. END;
  93.  
  94. (********************************************************************************************)
  95. (*        T A p p l i c a t i o n                                                                *)
  96. (********************************************************************************************)
  97. {$S Initialize}
  98. {-----------------------------------+
  99. |    IApplication                    |
  100. +-----------------------------------}
  101. PROCEDURE TApplication.IApplication;
  102.  
  103. VAR
  104.     envRec: sysEnvRec;
  105.     stkNeeded, heapSize: longint;
  106.     dummy: OSErr;
  107.     aDocList: TDocumentList;
  108.  
  109. BEGIN
  110.     { initialize Mac Toolbox components }
  111.     InitGraf(@qd.thePort);
  112.     InitFonts;
  113.     InitWindows;
  114.     InitMenus;
  115.     TEInit;
  116.     InitDialogs(NIL);
  117.     InitCursor;
  118.  
  119.     { Unload data segment: note that _DataInit must not be in Main! }
  120.     UnloadSeg(@_DataInit);
  121.  
  122.     { Ignore the error returned from SysEnvirons; even if an error occurred, }
  123.     { the SysEnvirons glue will fill in the SysEnvRec }
  124.     dummy := SysEnvirons(curSysEnvVers, envRec);
  125.  
  126.     { Are we running on a 128K ROM machine or better??? }
  127.     IF (envRec.machineType < 0) THEN
  128.       BigBadError(kErrStrings,eWrongMachine);        { if not, alert & quit }
  129.  
  130.     { if we need more stack space, get it now }
  131.     stkNeeded := StackNeeded;
  132.     IF (stkNeeded > StackSpace) THEN BEGIN
  133.         { new address is heap size + current stack - needed stack }
  134.         SetApplLimit(Ptr((longint(GetApplLimit) - stkNeeded + StackSpace)));
  135.     END;
  136.     
  137.     { Check for minimum heap size }
  138.     heapSize := longint(GetApplLimit) - longint(ApplicationZone);
  139.     IF (heapSize < HeapNeeded) THEN
  140.       BigBadError(kErrStrings,eSmallSize);
  141.  
  142.     { expand the heap so new code segments load at the top }
  143.     MaxApplZone;
  144.  
  145.     { allocate an empty document list }
  146.     NEW(aDocList);
  147.     fDocList := aDocList;
  148.     fDocList.IDocumentList;
  149.  
  150.     { check to see if WaitNextEvent is implemented }
  151.     fHaveWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
  152.  
  153.     { initialize our class variables }
  154.     fCurDoc := NIL;
  155.     fDone := FALSE;
  156.     fInBackground := FALSE;
  157.     fMouseRgn := NIL;
  158.     fWhichWindow := NIL;
  159. END;
  160.  
  161. {$S Main}
  162. {-----------------------------------+
  163. |    EventLoop                        |
  164. +-----------------------------------}
  165. PROCEDURE TApplication.EventLoop;
  166. VAR
  167.     gotEvent: Boolean;
  168.     anEvent: EventRecord;
  169. BEGIN
  170.  
  171.     SetUp;        { call setup routine }
  172.     DoIdle;        { do idle once }
  173.  
  174.     WHILE (fDone = FALSE) DO BEGIN
  175.  
  176.         { always set up fWhichWindow before doing anything }
  177.         fWhichWindow := FrontWindow;
  178.         IF (fWhichWindow <> nil) then begin
  179.             { see if window belongs to a document }
  180.             fCurDoc := fDocList.FindDoc(fWhichWindow);
  181.             { make sure we always draw into correct window }
  182.             SetPort(fWhichWindow);
  183.         END ELSE BEGIN
  184.             fCurDoc := nil;
  185.         END;
  186.  
  187.  
  188.         DoIdle;            { call idle time handler }
  189.  
  190.         IF (fHaveWaitNextEvent) THEN BEGIN
  191.             gotEvent := WaitNextEvent(everyEvent, anEvent, SleepVal, fMouseRgn);
  192.         END ELSE BEGIN
  193.             SystemTask;
  194.             gotEvent := GetNextEvent(everyEvent, anEvent);
  195.         END;
  196.         fTheEvent := anEvent;
  197.  
  198.         { make sure we got a real event }
  199.         IF gotEvent THEN BEGIN
  200.             AdjustCursor;
  201.             CASE (fTheEvent.what) OF
  202.                 mouseDown    : HdlMouseDown;
  203.                 mouseUp        : HdlMouseUp;
  204.                 keyDown,
  205.                 autoKey        : HdlKeyDown;
  206.                 updateEvt    : HdlUpdateEvt;
  207.                 diskEvt        : HdlDiskEvt;
  208.                 activateEvt    : HdlActivateEvt;
  209.                 kOsEvent     : HdlOSEvent;
  210.             END; { end switch (fTheEvent.what) }
  211.         END; { if gotEvent }
  212.         AdjustCursor;
  213.     END; {of EventLoop}
  214.     CleanUp;
  215. END;
  216.  
  217. {$S Main}
  218. {-----------------------------------+
  219. |    Setup                            |
  220. +-----------------------------------}
  221. PROCEDURE TApplication.Setup;        { Run before event loop starts }
  222. BEGIN
  223. END;
  224.  
  225. {$S Main}
  226. {-----------------------------------+
  227. |    CleanUp                            |
  228. +-----------------------------------}
  229. PROCEDURE TApplication.CleanUp;        { Run at end of loop }
  230. BEGIN
  231.     UnloadSeg(@InitSeg);
  232. END;
  233.  
  234. {$S Main}
  235. {-----------------------------------+
  236. |    ExitLoop                        |
  237. +-----------------------------------}
  238. PROCEDURE TApplication.ExitLoop;    { Call this to exit loop }
  239. BEGIN
  240.     fDone := TRUE;
  241. END;
  242.  
  243. {$S Main}
  244. {-----------------------------------+
  245. |    DoIdle                            |
  246. +-----------------------------------}
  247. PROCEDURE TApplication.DoIdle;        { Idle time handler (blink caret, background tasks) }
  248. BEGIN
  249. END;
  250.  
  251. {$S Main}
  252. {-----------------------------------+
  253. |    AdjustMenus                        |
  254. +-----------------------------------}
  255. PROCEDURE TApplication.AdjustMenus;    { Menu Updater routine }
  256. BEGIN
  257. END;
  258.  
  259. {$S Main}
  260. {-----------------------------------+
  261. |    HdlOSEvent                        |
  262. +-----------------------------------}
  263. PROCEDURE TApplication.HdlOSEvent;        { Calls DoSuspend, DoResume and DoIdle as apropos }
  264. VAR
  265.     doConvert: Boolean;
  266.     evType: byte;
  267. BEGIN
  268.  
  269.     { is it a multifinder event? }
  270.     evType := BAnd(BRotR(fTheEvent.message, 24),$00FF);
  271.     CASE evType OF        { high byte of message is type of event }
  272.         kMouseMovedMessage :
  273.             DoIdle;                    { mouse-moved is also an idle event }
  274.         kSuspendResumeMessage : BEGIN
  275.             doConvert := (BAnd(fTheEvent.message, kClipConvertMask) <> 0);
  276.             fInBackground := (BAnd(fTheEvent.message, kResumeMask) = 0);
  277.             IF (fInBackground) THEN
  278.                 DoSuspend(doConvert)
  279.             ELSE
  280.                 DoResume(doConvert);
  281.         END; { kSuspendResumeMessage }
  282.     END; { CASE Statement }
  283. END;
  284.  
  285. {$S Main}
  286. {-----------------------------------+
  287. |    HdlMouseDown                    |
  288. +-----------------------------------}
  289. PROCEDURE TApplication.HdlMouseDown;    { Calls DoContent, DoGrow, DoZoom, etc }
  290. VAR
  291.     mResult: Longint;
  292.     partCode: integer;
  293.     anEvent: EventRecord;
  294.     aWindow: WindowPtr;
  295. BEGIN
  296.     partCode := FindWindow(fTheEvent.where, aWindow);
  297.     fWhichWindow := aWindow;
  298.     CASE partCode OF
  299.         inSysWindow : MouseInSysWindow;
  300.         inMenuBar : BEGIN
  301.             AdjustMenus;
  302.             mResult := MenuSelect(fTheEvent.where);
  303.             IF (mResult <> 0) THEN
  304.               DoMenuCommand(HiWord(mResult),LoWord(mResult));
  305.         END;
  306.         inGoAway :
  307.             DoGoAway;
  308.         inDrag :
  309.             DoDrag;
  310.         inGrow :
  311.             IF (fCurDoc <> NIL) THEN BEGIN
  312.                 anEvent := fTheEvent;
  313.                 fCurDoc.DoGrow(anEvent);
  314.             END;
  315.         inZoomIn,
  316.         inZoomOut :
  317.             IF ((TrackBox(fWhichWindow, fTheEvent.where, partCode)) AND
  318.                     (fCurDoc <> NIL)) THEN
  319.                   fCurDoc.DoZoom(partCode);
  320.         inContent : { If window is not in front, make it so }
  321.             IF (fWhichWindow <> FrontWindow) THEN
  322.                 SelectWindow(fWhichWindow)
  323.             ELSE IF (fCurDoc <> NIL) THEN BEGIN
  324.                 anEvent := fTheEvent;
  325.                 fCurDoc.DoContent(anEvent);
  326.             END;
  327.     END;
  328. END;
  329.  
  330. {$S Main}
  331. {-----------------------------------+
  332. |    HdlKeyDown                        |
  333. +-----------------------------------}
  334. PROCEDURE TApplication.HdlKeyDown;        { also called for autokey events }
  335. VAR
  336.     key: char;
  337.     mResult: longint;
  338.     anEvent: EventRecord;
  339. BEGIN
  340.     key := char(BAnd(fTheEvent.message, charCodeMask));
  341.     IF ((BAnd(fTheEvent.modifiers, cmdKey) <> 0) AND (fTheEvent.what = keyDown)) THEN BEGIN
  342.         { only do command keys if we are not autokeying }
  343.         AdjustMenus;                    { make sure menus are up to date }
  344.         mResult := MenuKey(key);
  345.         IF (mResult <> 0) THEN BEGIN    { if it wasn't a menu key, pass it through }
  346.             DoMenuCommand(HiWord(mResult), LoWord(mResult));
  347.         END;
  348.     END ELSE BEGIN
  349.         IF (fCurDoc <> nil) THEN BEGIN
  350.             anEvent := fTheEvent;
  351.           fCurDoc.DoKeyDown(anEvent);
  352.         END;
  353.     END;
  354. END;
  355.  
  356. {$S Main}
  357. {-----------------------------------+
  358. |    HdlActivateEvt                    |
  359. +-----------------------------------}
  360. PROCEDURE TApplication.HdlActivateEvt;    { handles setup, and calls DoActivate (below) }
  361. BEGIN
  362.     { event record contains window ptr }
  363.     fWhichWindow := WindowPtr(fTheEvent.message);
  364.  
  365.     { see if window belongs to a document }
  366.     fCurDoc := fDocList.FindDoc(fWhichWindow);
  367.     SetPort(fWhichWindow);
  368.  
  369.     IF (fCurDoc <> NIL) THEN BEGIN
  370.         fCurDoc.DoActivate(BAnd(fTheEvent.modifiers, activeFlag) <> 0);
  371.     END;
  372. END;
  373.  
  374. {$S Main}
  375. {-----------------------------------+
  376. |    HdlUpdateEvt                    |
  377. +-----------------------------------}
  378. PROCEDURE TApplication.HdlUpdateEvt;    { handles setup, and calls DoUpdate (below) }
  379. BEGIN
  380.     { event record contains window ptr }
  381.     fWhichWindow := WindowPtr(fTheEvent.message);
  382.  
  383.     { see if window belongs to a document }
  384.     fCurDoc := fDocList.FindDoc(fWhichWindow);
  385.     SetPort(fWhichWindow);
  386.  
  387.     IF (fCurDoc <> NIL) THEN BEGIN
  388.         fCurDoc.DoUpdate;
  389.     END;
  390. END;
  391.  
  392. {$S Main}
  393. {-----------------------------------+
  394. |    HdlMouseUp                        |
  395. +-----------------------------------}
  396. PROCEDURE TApplication.HdlMouseUp;
  397. BEGIN
  398. END;
  399.  
  400. {$S Main}
  401. {-----------------------------------+
  402. |    HdlDiskEvt                        |
  403. +-----------------------------------}
  404. PROCEDURE TApplication.HdlDiskEvt;
  405. BEGIN
  406. END;
  407.  
  408. {$S Main}
  409. {-----------------------------------+
  410. |    MouseInSysWindow                |
  411. +-----------------------------------}
  412. PROCEDURE TApplication.MouseInSysWindow;
  413. VAR
  414.     anEvent: EventRecord;
  415. BEGIN
  416.     anEvent := fTheEvent;
  417.     SystemClick(anEvent,fWhichWindow);
  418. END;
  419.  
  420. {$S Main}
  421. {-----------------------------------+
  422. |    DoDrag                            |
  423. +-----------------------------------}
  424. PROCEDURE TApplication.DoDrag;
  425. BEGIN
  426.     DragWindow(fWhichWindow, fTheEvent.where, qd.screenBits.bounds);
  427. END;
  428.  
  429. {$S Main}
  430. {-----------------------------------+
  431. |    DoGoAway                        |
  432. +-----------------------------------}
  433. PROCEDURE TApplication.DoGoAway;
  434. VAR
  435.     aWindow: WindowPeek;
  436. BEGIN
  437.     IF (TrackGoAway(fWhichWindow, fTheEvent.where)) THEN BEGIN
  438.         IF (fCurDoc <> NIL) THEN BEGIN
  439.             fDocList.RemoveDoc(fCurDoc);
  440.             fCurDoc.Free;    {TDocument.Free disposes of window}
  441.         END ELSE BEGIN
  442.             aWindow := WindowPeek(fWhichWindow);
  443.             CloseDeskAcc(aWindow^.windowKind);
  444.         END;
  445.         
  446.         { make sure our current document/window references are valid }
  447.         fWhichWindow := FrontWindow;
  448.         IF (fWhichWindow <> NIL) THEN BEGIN
  449.             fCurDoc := fDocList.FindDoc(fWhichWindow);
  450.             SetPort(fWhichWindow);
  451.         END ELSE
  452.             fCurDoc := NIL;
  453.  
  454.     END;
  455. END;
  456.  
  457. {$S Main}
  458. {-----------------------------------+
  459. |    AdjustCursor                    |
  460. +-----------------------------------}
  461. PROCEDURE TApplication.AdjustCursor;    { cursor adjust routine, should setup mouseRgn }
  462. BEGIN
  463. END;
  464.  
  465. {$S Main}
  466. {-----------------------------------+
  467. |    DoMenuCommand                    |
  468. +-----------------------------------}
  469. PROCEDURE TApplication.DoMenuCommand(menuID,menuItem: integer);
  470. BEGIN
  471. END;
  472.  
  473. {$S Main}
  474. {-----------------------------------+
  475. |    DoSuspend                        |
  476. +-----------------------------------}
  477. PROCEDURE TApplication.DoSuspend(VAR doClipConvert:Boolean);
  478. BEGIN
  479.     doClipConvert := FALSE;
  480.     IF (fCurDoc <> NIL) THEN
  481.       fCurDoc.DoActivate(NOT (fInBackground));
  482. END;
  483.  
  484. {$S Main}
  485. {-----------------------------------+
  486. |    DoResume                        |
  487. +-----------------------------------}
  488. PROCEDURE TApplication.DoResume(VAR doClipConvert:Boolean);
  489. BEGIN
  490.     doClipConvert := FALSE;
  491.     IF (fCurDoc <> NIL) THEN
  492.       fCurDoc.DoActivate(NOT(fInBackground));
  493. END;
  494.  
  495. {$S Initialize}
  496. {-----------------------------------+
  497. |    TrapAvailable                    |
  498. +-----------------------------------}
  499. FUNCTION TApplication.TrapAvailable(tNumber:integer;tType:TrapType):Boolean;
  500. BEGIN
  501.     { See if the trap exists. On 64K ROM machines, tType will be ignored. }
  502.     TrapAvailable := NGetTrapAddress(tNumber, tType) <>
  503.                         NGetTrapAddress(_Unimplemented, ToolTrap);
  504. END;
  505.  
  506. {$S Main}
  507. {-----------------------------------+
  508. |    DocList                            |
  509. +-----------------------------------}
  510. FUNCTION TApplication.DocList:TDocumentList;
  511. BEGIN
  512.     DocList := fDocList;
  513. END;
  514.  
  515. {$S Initialize}
  516. {-----------------------------------+
  517. |    StackNeeded                        |
  518. +-----------------------------------}
  519. FUNCTION TApplication.StackNeeded: Longint;
  520. BEGIN
  521.     StackNeeded := 0;
  522. END;
  523.  
  524. {$S Initialize}
  525. {-----------------------------------+
  526. |    HeapNeeded                        |
  527. +-----------------------------------}
  528. FUNCTION TApplication.HeapNeeded: Longint;
  529. BEGIN
  530.     HeapNeeded := 0;
  531. END;
  532.  
  533. {$S Main}
  534. {-----------------------------------+
  535. |    SleepVal                        |
  536. +-----------------------------------}
  537. FUNCTION TApplication.SleepVal: LongInt;
  538. BEGIN
  539.     SleepVal := 0;
  540. END;
  541.